home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / simcode.arc / ESCPAR.PAS < prev    next >
Pascal/Delphi Source File  |  1985-01-19  |  14KB  |  582 lines
  1. {$symtab-,$pagesize:84,$linesize:131,$debug-,
  2. $title:'ESCPAR.PAS -- Process ESCAPE sequences'}
  3. {    COPYRIGHT @ 1982
  4.     Jim Holtman and Eric Holtman
  5.     35 Dogwood Trail
  6.     Randolph, NJ 07869
  7.     (201) 361-3395
  8. }
  9.  
  10.  module escpar;
  11. {$include:'simterm.inc'}
  12.  
  13.     const
  14.        printer_tabs = chr(27)*'D'*chr(8)*chr(16)*chr(24)*chr(32)*chr(40)* chr(
  15.         48)*chr(56)*chr(64)*chr(72)*chr(80)*chr(88)*chr(96)* chr(104)*chr(
  16.         112)*chr(120)*chr(128)*chr(132)*chr(0);
  17.        printer_compressed = chr(15);
  18.        proportional_enable = chr(27)*'p1';
  19.        emphasized_enable = chr(27)*'E';
  20.        eight_per_inch = chr(27)*'0'*chr(27)*'C'*chr(88);
  21.        printer_init = chr(27)*'@'; {EPSON w/GRAFTRAX init}
  22.        elite_8 = chr(27)*'!A'*chr(27)*'A'*chr(9);
  23.        elite_6 = chr(27)*'!A'*chr(27)*'A'*chr(12);
  24.  
  25.     var
  26.        [public] insert_mode : boolean;
  27.        display_mode : PRT_ATTR;
  28.  
  29.     var
  30.        italic_sw : boolean;       {true => ITALICS; false => underline}
  31.        graftrax [external] : boolean;
  32.        adm_sim_flag [external] : boolean;
  33.        hp_sim_flag [external] : boolean;
  34.        rogue_mode [external] : boolean;
  35.        function_keys [external] : array[1..10] of lstring(30);
  36.        ignore_rubout [external] : boolean;
  37.  
  38.                    {$include:'graph.inc'}
  39.                    {$include:'comm.inc'}
  40.  
  41.     procedure putchar(inchar : char);
  42.  
  43.        external;
  44.  
  45.     procedure display_keys;
  46.  
  47.        external;
  48.  
  49.     function getc(exit_flag : LOOP_FLAG) : integer;
  50.  
  51.        external;
  52.  
  53.     procedure ck(a : integer;
  54.      const b : string);
  55.  
  56.        forward;
  57.  
  58.     procedure save_line(line : CRT_SIZE;
  59.      inc : INC_LIMIT);
  60.  
  61.        external;
  62.  
  63.     function modem_status : byte;
  64.  
  65.        external;
  66.  
  67.     procedure setmode(mode : PRT_ATTR);
  68.                    {set attr mode, change printer}
  69.  
  70.        var
  71.       prt_flag [public] : boolean;
  72.       value prt_flag := false;
  73.  
  74.        begin
  75.       case mode of
  76.          PRT_NORMAL: begin
  77.         if prt_flag and graftrax then 
  78.            case display_mode of
  79.  
  80.               PRT_UNDERLINE: 
  81.              if italic_sw then xlpt1(chr(27)*'5')
  82.                    {italics OFF}
  83.              else xlpt1(chr(27)*'-'*chr(0));
  84.                    {underline OFF}
  85.  
  86.               PRT_SUPER,PRT_SUB: xlpt1(chr(27)*'H');
  87.                    {turn off super/subscripts}
  88.  
  89.               PRT_BOLD: xlpt1(chr(27)*'F');
  90.                    {turn off emphasized mode}
  91.  
  92.               otherwise ;
  93.  
  94.               end   ;
  95.         end;
  96.          PRT_UNDERLINE:      
  97.         if prt_flag and graftrax then       
  98.            if italic_sw then xlpt1(chr(27)*'4')
  99.                    {italics ON}
  100.            else xlpt1(chr(27)*'-'*chr(1))   ;
  101.                    {underline ON}
  102.          PRT_SUPER: 
  103.         if prt_flag and graftrax then xlpt1(chr(27)*'S'*chr(0))   ;
  104.                    {superscript}
  105.          PRT_SUB: 
  106.         if prt_flag and graftrax then xlpt1(chr(27)*'S'*chr(1))   ;
  107.                    {subscripts}
  108.          PRT_BOLD: 
  109.         if prt_flag and graftrax then xlpt1(chr(27)*'E')  ;
  110.          end;
  111.       display_mode := mode;
  112.       end;
  113.  
  114.     procedure hp_cursor;
  115.  
  116.        var
  117.       i,j,x,y : integer;
  118.       sign : char;
  119.  
  120.        begin
  121.       i := getc(HANG);
  122.       if (chr(i) = '+') or (chr(i) = '-') then begin
  123.                    {RELATIVE ADDRESSING}
  124.          sign := chr(i);
  125.          xrcurp(x,y);
  126.          i := 0;
  127.          j := 0;
  128.          while true do begin
  129.         j := getc(HANG);
  130.         if (chr(j) < '0') or (chr(j) > '9') then break;
  131.         i := i*10 + (j-ord('0'));
  132.         end;
  133.          if (sign = '-') then i := -i;
  134.          y := y + i;
  135.          i := getc(HANG);
  136.          sign := chr(i);
  137.          i := 0;
  138.          j := 0;
  139.          while true do begin
  140.         j := getc(HANG);
  141.         if (chr(j) < '0') or (chr(j) > '9') then break;
  142.         i := i*10 + (j-ord('0'));
  143.         end;
  144.          if (sign = '-') then i := -i;
  145.          x := x + i;
  146.          end
  147.       else begin
  148.          j := i;           {we already read one character above }
  149.          i := 0;
  150.          while true do begin
  151.         if (chr(j) < '0') or (chr(j) > '9') then break;
  152.         i := i*10 + (j-ord('0'));
  153.         j := getc(HANG);
  154.         end;
  155.          y := i;
  156.          i := 0;
  157.          j := 0;
  158.          while true do begin
  159.         j := getc(HANG);
  160.         if (chr(j) < '0') or (chr(j) > '9') then break;
  161.         i := i*10 + (j-ord('0'));
  162.         end;
  163.          x := i;
  164.          end;
  165.       if (chr(j) = 'C') then xxmove(x,y)
  166.       else xxmove(y,x);
  167.       end;
  168.  
  169.     procedure hp_convert(var c : integer);
  170.  
  171.        begin
  172.       case chr(c) of
  173.          'F': c := ord(chr('X'));
  174.          'S': c := ord(chr('Y'));
  175.          'T': c := ord(chr('Z'));
  176.          'R': c := ord(chr('E'));
  177.          'P': c := ord(chr('R'));
  178.          otherwise ;
  179.          end;
  180.       end;
  181.  
  182.     procedure up_load_remote(const fn : lstring);
  183.  
  184.        external;
  185.  
  186.     procedure down_load_remote(const fn : lstring);
  187.  
  188.        external;
  189.  
  190.     procedure xmodem_up_remote(const fn : lstring);
  191.  
  192.        external;
  193.  
  194.     procedure xmodem_down_remote(const fn : lstring);
  195.  
  196.        external;
  197.  
  198.     procedure escape;
  199.  
  200.        const
  201.       ESC_CHAR = chr(27);
  202.  
  203.        var
  204.       prt_flag [external] : boolean;
  205.       lpt_only_flag [external] : boolean;
  206.       direct_printer_flag [public] : boolean;
  207.       vi_cursor [public] : boolean;
  208.       x,y,old_y:integer;
  209.       ch:char;
  210.       i:integer;
  211.       j,k : integer;
  212.       graflin : lstring(1);
  213.       ca : integer;
  214.       fname : lstring(100);
  215.       value direct_printer_flag := false;
  216.       vi_cursor := false;
  217.  
  218.        begin
  219.       graflin[0] := chr(1);
  220.       xrcurp(x,y);
  221.       i := getc(HANG);
  222.       if (hp_sim_flag) then hp_convert(i);
  223.       ch := chr(i);
  224.       case ch of
  225.  
  226.          'A':                  {cursor up}
  227.           begin
  228.         save_line(y,-1);
  229.         if (y>TOP) then xxmove(x,y-1);
  230.         end;
  231.  
  232.          'B':                  {cursor down}
  233.           begin
  234.         save_line(y,1);
  235.         if (y<BOTTOM) then xxmove(x,y+1);
  236.         end;
  237.  
  238.          'C':                  {cursor right}
  239.         if (x<RIGHT_MAR) then xxmove(x+1,y)   ;
  240.  
  241.          'D':                  {left}
  242.         if (x>LEFT_MAR) then xxmove(x-1,y)   ;
  243.          
  244.          'd':                  { remotely initiated download }
  245.           begin
  246.         i := getc(HANG);
  247.         k := 1;
  248.         j := getc(HANG);
  249.         while (j <> 26) do begin
  250.            fname[k] := chr(j);
  251.            k := k + 1;
  252.            j := getc(HANG);
  253.            end;
  254.         fname[0] := chr(k-1);
  255.         if (chr(i) = 'a') then down_load_remote(fname);
  256.         if (chr(i) = 'x') then xmodem_down_remote(fname);
  257.         end;
  258.  
  259.          'E':                  {Exit INSERT mode}
  260.           insert_mode := false;
  261.  
  262.          'F':                  { program a function key }
  263.           begin
  264.         i := getc(HANG);
  265.         i := i - ord('0');
  266.         if (i = 0) then i := 10;
  267.         k := 1;
  268.         if ( (i>0) and (i<11) ) then begin
  269.            j := getc(HANG);
  270.            while (j <> 26) do begin
  271.               if (j = 27) then j := 13;
  272.               function_keys[i,k] := chr(j);
  273.               k := k + 1;
  274.               j := getc(HANG);
  275.               end;
  276.            function_keys[i,0] := chr(k-1);
  277.            end;
  278.         display_keys;
  279.         xxmove(x,y);
  280.         end;
  281.  
  282.          'G':                  { set up for one line of grafics on printer.
  283.                       }
  284.           begin
  285.         i := getc(HANG);
  286.         case chr(i) of
  287.            '0' : begin
  288.               xlpt1(chr(27)*'A'*chr(7));
  289.               xlpt1(chr(27)*'K'*chr(223)*chr(1));
  290.               for j := 1 to 479 do begin
  291.              i := getc(HANG);
  292.              graflin[1]:=chr(i);
  293.              xlpt1(graflin);
  294.              end;
  295.               end;
  296.            '1': begin
  297.               xlpt1(chr(27)*'A'*chr(7));
  298.               xlpt1(chr(27)*'L'*chr(192)*chr(3));
  299.               for j := 1 to 959 do begin
  300.              i := getc(HANG);
  301.              graflin[1]:=chr(i);
  302.              xlpt1(graflin);
  303.              end;
  304.               end;
  305.            otherwise ;       {ignore}
  306.            end;
  307.         end;
  308.  
  309.          'H':                  {home}
  310.           xxmove(LEFT_MAR,TOP);
  311.  
  312.          'K':                  {clear line from x}
  313.           xwca(NULLB,(RIGHT_MAR+1)-x);
  314.  
  315.          'J': begin            {clear display}
  316.         xwca(NULLB,(RIGHT_MAR+1)-x);
  317.         for i := y+1 to BOTTOM do begin
  318.            xxmove(LEFT_MAR,i);
  319.            xwca(NULLB,(RIGHT_MAR+1))   end;
  320.         xxmove(x,y)   end;
  321.  
  322.          'L':                  {insert line}
  323.           xscrldn(1,y,BOTTOM);
  324.  
  325.          'M':                  {delete line}
  326.           xscrlup(1,y,BOTTOM);
  327.  
  328.          'P':                  { change printer states }
  329.           begin
  330.         i := getc(HANG);
  331.         case chr(i) of
  332.  
  333.            '1','2','P','E','+','e' :
  334.                    {printer -- Full Mode}
  335.                    {P == proportional mode enable also}
  336.                    {E == emphasized mode enable also}
  337.                    {+ == ELITE mode at 8 lines/inch}
  338.                    {e == ELITE mode at 6 lines/inch}
  339.             begin
  340.               prt_flag := true;
  341.               lpt_only_flag := false;
  342.               direct_printer_flag := false;
  343.               italic_sw := false;
  344.               xlpt1(null); {init the printer}
  345.               if graftrax then xlpt1(printer_init);
  346.               if chr(i)='2' then xlpt1(printer_compressed);
  347.               if chr(i)='P' then xlpt1(proportional_enable);
  348.               if chr(i)='E' then xlpt1(emphasized_enable);
  349.               if chr(i)='+' then xlpt1(elite_8);
  350.               if chr(i)='e' then xlpt1(elite_6);
  351.               end;
  352.  
  353.            '0':            {turn off the printer}
  354.             begin
  355.               prt_flag := false;
  356.               lpt_only_flag := false;
  357.               direct_printer_flag := false;
  358.               end;
  359.  
  360.            'i':            {turn on ITALICS}
  361.             italic_sw := true;
  362.  
  363.            otherwise ;       {ignore}
  364.  
  365.            end;
  366.         end;
  367.  
  368.          'Q':                  {enter INSERT mode}
  369.           insert_mode := true;
  370.  
  371.          'R': begin            {delete char}
  372.         for i := x to (RIGHT_MAR-1) do begin
  373.            xxmove(i+1,y);
  374.            ca:=xrca;
  375.            xxmove(i,y);
  376.            xwca(ca,1)    end;
  377.         xxmove(RIGHT_MAR,y);
  378.         xwca(NULLB,1);
  379.         xxmove(x,y)   end;
  380.  
  381.          'T':                  {Terminal modes. switch between adm3a &
  382.                       simterm and also}
  383.                    {between whether or not we're playing ROGUE}
  384.           begin
  385.         i := getc(HANG);
  386.         case chr(i) of
  387.  
  388.            'A': adm_sim_flag := true;
  389.            'a': adm_sim_flag := false;
  390.            'R': rogue_mode := true;
  391.            'r': rogue_mode := false;
  392.  
  393.            otherwise
  394.               vi_cursor := false;
  395.  
  396.            end;
  397.         end;
  398.  
  399.          'u':                  { remotely initiated upload }
  400.           begin
  401.         i := getc(HANG);
  402.         k := 1;
  403.         j := getc(HANG);
  404.         while (j <> 26) do begin
  405.            fname[k] := chr(j);
  406.            k := k + 1;
  407.            j := getc(HANG);
  408.            end;
  409.         fname[0] := chr(k-1);
  410.         if (chr(i) = 'a') then up_load_remote(fname);
  411.         if (chr(i) = 'x') then xmodem_up_remote(fname);
  412.         end;
  413.  
  414.  
  415.          'V':                  {'vi' control}
  416.           begin
  417.         i := getc(HANG);
  418.         case chr(i) of
  419.  
  420.            'S': vi_cursor := true;
  421.  
  422.            otherwise
  423.               vi_cursor := false;
  424.  
  425.            end;
  426.         end;
  427.  
  428.          'X':                  {home down for HP. Actually 'F', but it
  429.                       converted in hp_convert }
  430.           xxmove(0,23);
  431.  
  432.          'Y': xscrlup(1,24,BOTTOM);
  433.  
  434.          'Z': xscrldn(1,24,BOTTOM);
  435.  
  436.          '[':                  { repeat next char foo number of times }
  437.           begin
  438.         xrcurp(x,y);
  439.         i := getc(HANG);
  440.         ca := getc(HANG);
  441.         ca := ca + (7*256);
  442.         x := x + i;
  443.         if ( x > 79) then begin
  444.            x := x - 80;
  445.            y := y + 1;
  446.            if (y = 24) then begin
  447.               y := 23;
  448.               xscrlup(1,0,23);
  449.               end;
  450.            end;
  451.         xwca(ca,i);
  452.         xxmove(x,y);
  453.         end;
  454.          '>':                  { change cursor type }
  455.           begin
  456.         i := getc(HANG);
  457.         ca := getc(HANG);
  458.         xscurt(byword(ca,i));
  459.         end;
  460.          '&':                  { change the display mode }
  461.           begin
  462.         i := getc(HANG);
  463.         if (chr(i) = 'a') and (hp_sim_flag) then hp_cursor
  464.         else if (chr(i) = 'd') then begin
  465.            i := getc(HANG);
  466.            case chr(i) of
  467.               '@': setmode(PRT_NORMAL);
  468.               'B': setmode(PRT_BOLD);
  469.               'D': setmode(PRT_UNDERLINE);
  470.               'H': setmode(PRT_SUPER);
  471.               'L': setmode(PRT_SUB);
  472.               otherwise ;
  473.               end   end   end;
  474.          '=': begin            {move to x,y}
  475.         old_y := y;
  476.         y:=getc(HANG)-32;
  477.         x:=getc(HANG)-32;
  478.         if x < LEFT_MAR then x := LEFT_MAR
  479.         else if x > RIGHT_MAR then x := RIGHT_MAR;
  480.         if y < TOP then y := TOP
  481.         else if y > BOTTOM then y := BOTTOM;
  482.         if old_y <> y then save_line(old_y,2*ord(old_y<y)-1);
  483.         xxmove(x,y)   end;
  484.          '^':                  {request ID - send back 'IBM PC'}
  485.           send('IBM PC'*NL);
  486.  
  487.          ESC_CHAR:           {two ESC chars in a row; output one and
  488.                       continue}
  489.           putchar(ESC_CHAR);
  490.  
  491.          otherwise ;       {ignore ESC sequence}
  492.          end;
  493.       end;
  494.  
  495.     procedure parse(var c:integer);
  496.  
  497.        const
  498.       ESC = 27;           {ecsape key}
  499.  
  500.        begin
  501.       case c of
  502.          ESC: escape;
  503.  
  504.          17: ;           {^Q -- ignore}
  505.  
  506.          0: ;           {NULL, ignore, since space games use this as
  507.                       a fill, also HP series terminals do not
  508.                       advance cursor on null either}
  509.  
  510.          127: begin
  511.         if ( not ignore_rubout ) then putchar(chr(c));
  512.         end;
  513.  
  514.          26: begin           {^Z -- clear screen}
  515.         xxmove(LEFT_MAR,TOP);
  516.         xxcls    end;
  517.  
  518.          30: xxmove(LEFT_MAR,TOP);
  519.                    {^^ -- HOME}
  520.  
  521.          otherwise
  522.         putchar(chr(c));
  523.          end;
  524.       end;
  525.  
  526.     procedure ck;
  527.  
  528.        const
  529.       OK = -1;
  530.  
  531.        var
  532.       silent_mode [external] : boolean;
  533.  
  534.        begin
  535.       if (a <> OK) and not silent_mode then begin
  536.          writeln(output,'ERROR in ',b,'. Flag =',a, '  Status=',
  537.           modem_status:2:16);
  538.          end;
  539.       end;
  540.  
  541.     procedure adm_sim(ch : integer);
  542.  
  543.        var
  544.       x,y : integer;
  545.  
  546.        begin
  547.       xrcurp(x,y);
  548.       case ch of
  549.  
  550.          ord('^') and #1F:     {HOME}
  551.           xxmove(LEFT_MAR,TOP);
  552.  
  553.          27:           {ESCAPE}
  554.           escape;
  555.  
  556.          ord('H') and #1F:     {cursor left}
  557.         if (x > LEFT_MAR) then xxmove(x-1,y)   ;
  558.  
  559.          ord('K') and #1F:     {cursor up}
  560.           begin
  561.         save_line(y,-1);
  562.         if (y > TOP) then xxmove(x,y-1);
  563.         end;
  564.  
  565.          ord('L') and #1F:     {cursor right}
  566.         if (x < RIGHT_MAR) then xxmove(x+1,y)    ;
  567.  
  568.          ord('Q') and #1F:     {ignore} ;
  569.  
  570.          ord('Z') and #1F:     {clear screen}
  571.           begin
  572.         xxmove(LEFT_MAR,TOP);
  573.         xxcls;
  574.         end;
  575.  
  576.          otherwise
  577.         putchar(chr(ch));
  578.  
  579.          end;
  580.       end;
  581.  end.
  582.